VERSION 5.00
Begin VB.Form frmChange 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   870
   ClientLeft      =   150
   ClientTop       =   720
   ClientWidth     =   2565
   Icon            =   "frmChange.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   870
   ScaleWidth      =   2565
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox PicSystray 
      Height          =   735
      Left            =   0
      ScaleHeight     =   675
      ScaleWidth      =   2475
      TabIndex        =   0
      Top             =   120
      Width           =   2535
   End
   Begin VB.Menu mnuLista 
      Caption         =   "Lista"
      Begin VB.Menu mnuFolder 
         Caption         =   "&Add"
      End
      Begin VB.Menu mnuChange 
         Caption         =   "&Change"
      End
      Begin VB.Menu mnuCategory 
         Caption         =   "&Set Category"
         Begin VB.Menu mnuItem 
            Caption         =   ""
            Index           =   0
         End
      End
      Begin VB.Menu mnuTimer 
         Caption         =   "&Timer"
      End
      Begin VB.Menu mnuAbout 
         Caption         =   "&About"
      End
      Begin VB.Menu mnuEsci 
         Caption         =   "&Exit"
      End
   End
End
Attribute VB_Name = "frmChange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'tipo necessario per inserire nella systray
Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    ucallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLICK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLICK = &H206
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

Dim t As NOTIFYICONDATA
Dim TIPS As String

Const SPIF_UPDATEINIFILE = &H1
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As Long

Dim lngTimerID As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Wallpaper_Name As String
Private Counter As Date

Private Sub Form_Deactivate()
    mnuLista.Visible = False
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim intervallo As Long
    
    '#If SET_GRAPHIC_MENU = 1 Then
        Call FillIcon
        ModODMenus.SetFont = Me.Font
        ModODMenus.SetBmp = MenuBitmap
        Call ModODMenus.startODMenus(Me, True, False)
    '#End If
    
    'cambia desktop
    Call ChangeDesktop
    
    'ora posizionati nella systray
    t.cbSize = Len(t)
    t.hwnd = PicSystray.hwnd
    t.uId = 1&  '0
    t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    t.ucallbackMessage = WM_MOUSEMOVE
    t.hIcon = Me.Icon
    t.szTip = TIPS & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t
    Me.Hide
    
    'nasconde tutti i form al momento visibili
    For i = Forms.Count - 1 To 0 Step -1
        If Forms(i).Caption <> Me.Caption Then
            Forms(i).Hide
        End If
    Next i
    
    intervallo = GetSetting(App.Title, "Setting", "Interval", 0)
    If intervallo > 0 Then
        Call ActivateTimer(intervallo)
        Counter = Now
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
    t.cbSize = Len(t)
    t.hwnd = PicSystray.hwnd
    t.uId = 1&
    Shell_NotifyIcon NIM_DELETE, t
    
    Call ModODMenus.stopODMenus(Me)
End Sub

Private Sub mnuAbout_Click()
    frmAbout.Show
End Sub

Private Sub mnuChange_Click()
    frmChoose.Show
End Sub
Private Sub mnuEsci_Click()
    'chiudi ordinatamente tutti i form
    On Error Resume Next
    Dim i As Integer
    While Forms.Count > 1
        i = 0
        While Forms(i).Caption = Me.Caption
            i = i + 1
        Wend
        Unload Forms(i)
    Wend
    Unload Me
End Sub
Private Sub mnuFolder_Click()
    On Error Resume Next
    Call Shell(EXPLORER_PROG & App.Path & WALLPAPER_DIR, vbNormalFocus)
End Sub

Private Sub mnuItem_Click(Index As Integer)
    Dim category_name As String
    category_name = mnuItem(Index).Caption
    If category_name = "&No Category" Then
        Current_wallpaper_dir = WALLPAPER_DIR
        If GetSetting(App.Title, "Setting", "Wallpaper_path") <> vbNullString Then
                Call DeleteSetting(App.Title, "Setting", "Wallpaper_path")
        End If
    Else
        Current_wallpaper_dir = WALLPAPER_DIR & category_name & "\"
        'salva nel registro la selezione
        Call SaveSetting(App.Title, "Setting", "Wallpaper_path", category_name)
    End If
    
    Call ChangeChoosen(Index)

End Sub

Private Sub mnuLista_Click()
    Dim category As Variant
    Dim i As Long
    Dim CatScelta As String
    
    category = ModMain.DirList(App.Path & WALLPAPER_DIR)
    
    Load mnuItem(1)
    mnuItem(1).Caption = "&No Category"
    Load mnuItem(2)
    mnuItem(2).Caption = "-"
    For i = 0 To UBound(category) Step 1
        Load mnuItem(i + 3)
        mnuItem(i + 3).Caption = category(i)
    Next i
    
    CatScelta = GetSetting(App.Title, "Setting", "Wallpaper_Path", "&No Category")
    For i = 0 To mnuItem.UBound Step 1
        If mnuItem(i).Caption = CatScelta Then
            ChoosenCategory = i
            Exit For
        End If
    Next i
    mnuItem(0).Visible = False
    
    Call ChangeChoosen(ChoosenCategory)
End Sub

Private Sub mnuTimer_Click()
    On Error GoTo errore
    Dim intervallo As Long
    Dim ris As String
    If mnuTimer.Caption <> "&Timer enabled" Then
        ris = InputBox("Insert the refresh rate, in second", "Timer")
        If ris = vbNullString Then Exit Sub
        If Not IsNumeric(ris) Then
            MsgBox "Value not correct"
            Exit Sub
        End If
        
        intervallo = CLng(ris) * 1000
        If intervallo > 2147483646 Then
            MsgBox "Numero troppo grande!"
            Exit Sub
        End If
        Call ActivateTimer(intervallo)
        Call SaveSetting(App.Title, "Setting", "Interval", CStr(intervallo))
        Counter = Now
    Else
        Call ActivateTimer(0)
        If GetSetting(App.Title, "Setting", "Interval") <> vbNullString Then
            Call DeleteSetting(App.Title, "Setting", "Interval")
        End If
    End If
    
    ModODMenus.SetBmp = MenuBitmap()
    
    Exit Sub
errore:
    MsgBox Err.Number & Err.Description
End Sub

Private Sub PicSystray_GotFocus()
    PicSystray.ToolTipText = Wallpaper_Name & " in " & Current_wallpaper_dir
End Sub

'quando premi e muovi sopra la systray
Private Sub PicSystray_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
    On Error Resume Next
    Dim i As Long
    Static rec As Boolean, msg As Long
    msg = x / Screen.TwipsPerPixelX
    If rec = False Then
        rec = True
        Select Case msg
            Case WM_RBUTTONDOWN
                'cancella tutti i mnuitem
                'rendi visibile la voce (deve esserci almeno un menu visibile)
                mnuItem(0).Visible = True
                For i = mnuItem.Count - 1 To 1 Step -1
                    Unload mnuItem(i)
                Next i

                mnuLista.Visible = True
                 SetForegroundWindow Me.hwnd
                Me.PopupMenu Me.mnuLista
            Case WM_LBUTTONDBLCLICK
                Call ChangeDesktop
        End Select
        rec = False
    End If
End Sub

'cambia il desktop
Public Function ChangeDesktop() As Boolean
    Dim FileSystem As Variant
    Dim TempFile As Variant
    Dim TempDir As Variant
    Dim MyDic As Scripting.Dictionary
    Dim WallpaperFolder As Scripting.Folder
    Dim OtherFolder As Scripting.Folders
    Dim WallpaperFiles As Scripting.Files
    Dim FileIndex As Long
    Dim FilePath As String
    Dim i As Long
    Dim temp As String
     
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    
    'salvare il dic in qualche modo (in un modulo) per risparimiare tempo cpu??
    'dopo occorrerebbe riavviare il prog per identificare nuovi wallpapers
    
    'se esiste la directory wallpaper
    If Not DirExist(App.Path & Current_wallpaper_dir) Then
        Current_wallpaper_dir = WALLPAPER_DIR
    End If
        
    Set WallpaperFolder = FileSystem.GetFolder(App.Path & Current_wallpaper_dir)
    Set WallpaperFiles = WallpaperFolder.Files
    Set OtherFolder = WallpaperFolder.SubFolders
        
    Set MyDic = New Scripting.Dictionary
            
    'ogni folder riempie mydic
    'la prima iterazione riempie .\wallpaper
    For Each TempFile In WallpaperFiles
        MyDic.Add i, TempFile.Name
        i = i + 1
    Next TempFile
            
    For Each TempDir In OtherFolder
        'cambia wallpaperfiles
        'aggiungi la coppia chiave / nome
        Set WallpaperFiles = TempDir.Files
        For Each TempFile In WallpaperFiles
            MyDic.Add i, TempDir.Name & "\" & TempFile.Name
            i = i + 1
        Next TempFile
    Next TempDir
    
    'se non ci sono wallpaper cancella il desktop ed esci
    If MyDic.Count = 0 Then
        Call frmChange.RemoveDesktop
        Exit Function
    End If
            
    Randomize
    'indice random del file da caricare
    FileIndex = CInt((Rnd() * MyDic.Count)) - 1 'WallpaperFiles.Count
    If FileIndex < 0 Then FileIndex = 0
            
    'percorso del file da caricare
    Wallpaper_Name = MyDic(FileIndex)
    FilePath = App.Path & Current_wallpaper_dir & MyDic(FileIndex) 'WallpaperFiles(MyDic(FileIndex)).Name
    'salvalo nella directory come bmp e usalo per settare il wallpaper
    PicSystray.Picture = LoadPicture(FilePath)
    SavePicture PicSystray, App.Path & WALLPAPER_DEFAULT_NAME
    temp = App.Path & WALLPAPER_DEFAULT_NAME
    SystemParametersInfo SPI_SETDESKWALLPAPER, 0&, temp, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE
            
    'aggiungi un logfile
    #If IS_DEBUG = 1 Then
        Open App.Path & DEBUG_FILE For Append As #1
            Print #1, WallpaperFiles(MyDic(FileIndex)).Name & "/" & WallpaperFiles.Count
        Close #1
    #End If
        
    'set the instant in which the desktop change
    Counter = Now
    
    'free memory
    Set MyDic = Nothing
    Set OtherFolder = Nothing
    Set WallpaperFiles = Nothing
    Set WallpaperFolder = Nothing

End Function

'rimuove il desktop corrente di windows
Public Sub RemoveDesktop()
    Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "(none)", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
End Sub


Private Function ActivateTimer(ByVal Interval As Long) As Boolean
    'Starts and stops the timer.
    If Interval > 0 Then
        lngTimerID = SetTimer(0, 0, Interval, AddressOf ModCallback.TimerProc)
        If lngTimerID = 0 Then
            ActivateTimer = False
            Exit Function
        End If
        mnuTimer.Caption = "&Timer enabled"
    Else
        lngTimerID = KillTimer(0, lngTimerID)
        If lngTimerID = 0 Then
            ActivateTimer = False
            Exit Function
        End If
        mnuTimer.Caption = "&Timer"
    End If
    ActivateTimer = True
End Function

Private Sub FillIcon()
    
    ReDim MenuBitmap(7, 2)
    
    MenuBitmap(0, 0) = 101
    MenuBitmap(0, 1) = 101
    MenuBitmap(0, 2) = "&Add"
    
    MenuBitmap(1, 0) = 111
    MenuBitmap(1, 1) = 111
    MenuBitmap(1, 2) = "&Change"
    
    MenuBitmap(2, 0) = 103
    MenuBitmap(2, 1) = 103
    MenuBitmap(2, 2) = "&Set Category"
    
    MenuBitmap(3, 0) = 110
    MenuBitmap(3, 1) = 110
    MenuBitmap(3, 2) = "&Timer"
    
    MenuBitmap(4, 0) = 109
    MenuBitmap(4, 1) = 109
    MenuBitmap(4, 2) = "&About"
    
    MenuBitmap(5, 0) = 106
    MenuBitmap(5, 1) = 106
    MenuBitmap(5, 2) = "&Exit"
    
    MenuBitmap(6, 0) = 102
    MenuBitmap(6, 1) = 102
    MenuBitmap(6, 2) = "" '"&Exit"
    
    MenuBitmap(7, 0) = 110
    MenuBitmap(7, 1) = 110
    MenuBitmap(7, 2) = "&Timer enabled"
    
End Sub

Private Sub ChangeChoosen(ByVal Choosen As Long)
    If Choosen >= 0 Then
        MenuBitmap(6, 2) = mnuItem(Choosen).Caption
        ModODMenus.SetBmp = MenuBitmap()
        'mnuItem(ChoosenCategory).Checked = False
        'mnuItem(Choosen).Checked = True
        ChoosenCategory = Choosen
    End If
End Sub
